home *** CD-ROM | disk | FTP | other *** search
/ Packard Bell - Internet on a CD / internet on a cd.cdr / Internet / sites / Clementine_NASA / image.hqx / Image folder / Macros / LUT Macros < prev    next >
Encoding:
Text File  |  1991-08-07  |  4.3 KB  |  224 lines
  1. macro 'Export LUT [E]';
  2. {
  3. Copies the current look-up table to the Area(Red), Mean(Green) and
  4. Perimeter/Length(blue) columns. Use the Export command to copy
  5. it to a tab-delimeted text file. Max Measurements must be set to
  6. 256 or greater.
  7. }
  8. var
  9.   i:integer;
  10.   v:real;
  11. begin
  12.   SetCounter(256); {SetCounter new in V1.41}
  13.   MeasureArea(true);
  14.   MeasureDensity(true);
  15.   MeasurePerimeter(true);
  16.   for i:=0 to 255 do begin
  17.     rArea[i+1]:=RedLut[i];
  18.     rMean[i+1]:=GreenLut[i];
  19.     rLength[i+1]:=BlueLut[i];
  20.   end;
  21.   ShowResults;
  22.   {Export;}
  23. end;
  24.  
  25.  
  26. macro 'Invert LUT [I]';
  27. var
  28.   i:integer;
  29. begin
  30.   for i:=0 to 255 do begin
  31.     RedLUT[i]:=255-RedLut[i];
  32.     GreenLUT[i]:=255-GreenLut[i];
  33.     BlueLUT[i]:=255-BlueLut[i];
  34.     if (i mod 10)=0 then UpdateLUT;
  35.   end;
  36.   UpdateLUT;
  37. end;
  38.  
  39.  
  40. macro 'Random Colors [C]';
  41. var
  42.   i,colors,entries,first,last,r,g,b:integer;
  43. begin
  44.   colors:=25;;
  45.   entries:=256/colors;
  46.   if entries>256 then entries:=256;
  47.   repeat 
  48.     first:=random*255;
  49.     last:=first+entries-1;
  50.     if last>255 then last:=255;
  51.     r:=random*255;
  52.     g:=random*255;
  53.     b:=random*255;
  54.     for i:=first to last do begin
  55.       RedLUT[i]:=r;
  56.       GreenLUT[i]:=g;
  57.       BlueLUT[i]:=b;
  58.     end;
  59.     UpdateLUT;
  60.   until button;
  61. end;
  62.  
  63.  
  64. macro 'Log Tranform';
  65. var
  66.   i,v:integer;
  67.   ln255:real;
  68. BEGIN
  69.   RedLUT[255]:=0;
  70.   GreenLUT[255]:=0;
  71.   BlueLUT[255]:=0;
  72.   ln255:=ln(255);
  73.   for i:=1 to 255 DO begin
  74.     v:=round(ln(i)*255.0/ln255);
  75.     RedLUT[255-i]:=v;
  76.     GreenLUT[255-i]:=v;
  77.     BlueLUT[255-i]:=v;
  78.   end;
  79.   UpdateLUT;
  80. END.
  81.  
  82.  
  83. macro 'Square Tranform';
  84. var
  85.   i,v:integer;
  86.   sqr255:real;
  87. BEGIN
  88.   sqr255:=sqr(255.0);
  89.   for i:=1 to 255 DO begin
  90.     v:=round(sqr(i)*255.0/sqr255);
  91.     RedLUT[255-i]:=v;
  92.     GreenLUT[255-i]:=v;
  93.     BlueLUT[255-i]:=v;
  94.   end;
  95.   UpdateLUT;
  96. END.
  97.  
  98.  
  99. macro 'Square Root Tranform';
  100. var
  101.   i,v:integer;
  102.   sqrt255:real;
  103. BEGIN
  104.   sqrt255:=sqrt(255.0);
  105.   for i:=1 to 255 DO begin
  106.     v:=round(sqrt(i)*255.0/sqrt255);
  107.     RedLUT[255-i]:=v;
  108.     GreenLUT[255-i]:=v;
  109.     BlueLUT[255-i]:=v;
  110.   end;
  111.   UpdateLUT;
  112. END.
  113.  
  114. macro 'Reset LUT [R]';
  115. begin
  116.   ResetGrayMap;
  117. end;
  118.  
  119.  
  120. macro 'Plot LUT [P]';
  121. var
  122.   i,xscale,yscale:real;
  123.   width,height,margin,pwidth,pheight:integer;
  124.   xbase,ybase:integer;
  125. begin
  126.   SaveState;
  127.   margin:=25;
  128.   pwidth:=400;
  129.   pheight:=125;
  130.   width:=pwidth+2*margin;
  131.   height:=pheight*3+2*margin;
  132.   SetNewSize(width,height);
  133.   SetBackground(0); 
  134.   MakeNewWindow('LUT');
  135.   xscale:=(pwidth-2)/256;
  136.   yscale:=(pheight-1)/256;
  137.   SetForeground(252);
  138.   xbase:=margin; ybase:=margin;
  139.   MoveTo(xbase,ybase);
  140.   for i:=0 to 255 do
  141.     LineTo(xbase+i*xscale,ybase+RedLUT[i]*yscale);
  142.   SetForeground(255);
  143.   MakeRoi(xbase,ybase,pwidth,pheight);
  144.   FlipVertical;
  145.   DrawBoundary;
  146.   SetForeground(253);
  147.   ybase:=ybase+pheight-1;
  148.   MoveTo(xbase,ybase);
  149.   for i:=0 to 255 do
  150.     LineTo(xbase+i*xscale,ybase+GreenLUT[i]*yscale);
  151.   SetForeground(255);
  152.   MakeRoi(xbase,ybase,pwidth,pheight);
  153.   FlipVertical;
  154.   DrawBoundary;
  155.   SetForeground(254);
  156.   ybase:=ybase+pheight-1;
  157.   MoveTo(xbase,ybase);
  158.   for i:=0 to 255 do
  159.     LineTo(xbase+i*xscale,ybase+BlueLUT[i]*yscale);
  160.   SetForeground(255);
  161.   MakeRoi(xbase,ybase,pwidth,pheight);
  162.   FlipVertical;
  163.   DrawBoundary;
  164.   KillRoi;
  165.   RedLUT[252]:=255; GreenLUT[252]:=0;   BlueLUT[252]:=0;
  166.   RedLUT[253]:=0;   GreenLUT[253]:=255; BlueLUT[253]:=0;
  167.   RedLUT[254]:=0;   GreenLUT[254]:=0;   BlueLUT[254]:=255;
  168.   UpdateLUT;
  169.   SetFont('Geneva');
  170.   SetFontSize(9);
  171.   SetText('Centered');
  172.   MoveTo(margin+4,height-margin+8);
  173.   writeln(0:1:2);
  174.   MoveTo(margin+pwidth,height-margin+8);
  175.   writeln(255:1:2);
  176.   RestoreState;
  177. end;
  178.  
  179.  
  180. macro 'Show RGB Values [S]';
  181. var
  182.   x,y,v,savex,savey:integer;
  183. begin
  184.   repeat
  185.     savex:=x; savey:=y;
  186.     GetMouse(x,y);
  187.     if (x<>savex) or (y<>savey) then begin
  188.       v:=GetPixel(x,y);
  189.       ShowMessage('loc=',x:1,', ',y:1,
  190.         '\value=',v:1,
  191.         '\RGB=',RedLUT[v]:1,', ',GreenLUT[v]:1,', ',BlueLUT[v]:1);
  192.       wait(.5);
  193.     end;
  194.   until button;
  195. end;
  196.  
  197.  
  198. macro 'Posterize';
  199. var
  200.   level,i:integer
  201.   delta,steps,StepSize,NextStep:real;
  202. begin
  203.   steps:=GetNumber('Number of Gray Steps(2-256):',8);
  204.   StepSize:=256/steps;
  205.   delta:=256/(steps-1);
  206.   NextStep:=trunc(StepSize);
  207.   level:=255;
  208.   for i:=0 to 255 do begin
  209.     if i>=NextStep then begin
  210.       NextStep:=trunc(NextStep+StepSize);
  211.       level:=level-delta;
  212.       UpdateLUT;
  213.     end;
  214.     if level<0 then level:=0;
  215.     RedLUT[i]:=level;
  216.     GreenLUT[i]:=level;
  217.     BlueLUT[i]:=level;
  218.   end;
  219. end;
  220.  
  221.  
  222.  
  223.  
  224.